home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / comps / gadgets / delphi10 / gifbitmp / gifbitmp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-18  |  2.3 KB  |  87 lines
  1. unit Gifbitmp;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, CCGIF;
  8.  
  9. type
  10.   TGIFBitmap = class(TComponent)
  11.   private
  12.     { Private declarations }
  13.     FOnLoadGIF : TNotifyEvent;
  14.     FOnCreate  : TNotifyEvent;
  15.     FOnDestroy : TNotifyEvent;
  16.     TheGIF     : PGIF;
  17.   protected
  18.     { Protected declarations }
  19.   public
  20.     { Public declarations }
  21.     Width            : Longint;   { Holds the pixel width when done       }
  22.     Height           : Longint;   { Holds the pixel height when done      }
  23.     The_Name         : String;    { Holds the file name                   }
  24.     TheBMP           : TBitmap;
  25.     constructor Create( AOwner : TComponent ); override;
  26.     destructor Destroy; override;
  27.     procedure Load_GIF_File;
  28.   published
  29.     { Published declarations }
  30.     property FileName : String read The_Name write The_Name;
  31.     property OnCreate : TNotifyEvent read FOnCreate write FOnCreate;
  32.     property OnDestroy : TNotifyEvent read FOnDestroy write FOnDestroy;
  33.     property OnLoadGIFFile : TNotifyEvent read FOnLoadGIF write FOnLoadGIF;
  34.   end;
  35.  
  36. procedure Register;
  37.  
  38. implementation
  39.  
  40.  
  41. { This creates a file bitmap object }
  42. constructor TGIFBitmap.Create( AOwner : TComponent );
  43. begin
  44.   { call inherited FIRST! }
  45.   inherited Create( AOwner );
  46.   The_Name := '';
  47.   TheBMP := TBitmap.Create;
  48.   if Assigned(FOnCreate) then OnCreate( Self );
  49. end;
  50.  
  51. { This is the destructor procedure }
  52. destructor TGIFBitmap.Destroy;
  53. begin
  54.   if Assigned(FOnDestroy) then OnDestroy(Self);
  55.   TheBMP.Free;
  56.   { call inherited last }
  57.   inherited destroy;
  58. end;
  59.  
  60. procedure TGIFBitmap.Load_GIF_File;
  61. var thebuffer : array[ 0..255] of char;
  62.     TheGif : PGif;
  63. begin
  64.   if Assigned(FOnLoadGIF) then OnLoadGIFFile( Self );
  65.   if The_Name = '' then exit;
  66.   if not FileExists( The_Name ) then
  67.   begin
  68.     MessageDlg( The_Name + ' cannot be found!',mterror,[mbOK],0);
  69.     exit;
  70.   end;
  71.   Screen.Cursor := crHourGlass;
  72.   StrPCopy( TheBuffer , The_Name );
  73.   TheGif := NEW( PGif , Init( theBuffer ));
  74.   TheBMP.Width := TheGif^.ImageDescriptor.ImageWidth;
  75.   TheBMP.Height := TheGif^.ImageDescriptor.ImageHeight;
  76.   TheGif^.Decode( false , TheBMP );
  77.   Dispose( TheGif , Done );
  78.   Screen.Cursor := crDefault;
  79. end;
  80.  
  81. procedure Register;
  82. begin
  83.   RegisterComponents('Gadgets', [TGIFBitmap]);
  84. end;
  85.  
  86. end.
  87.